(DEF EQUAL
 (LAMBDA ($A $B)
   (COND ((AND  (DTPR $A)(DTPR $B))
         (AND (EQUAL (CAR $A) (CAR $B))
              (EQUAL (CDR $A) (CDR $B))))
        (T (EQ $A $B)))))
(DEF DEFEVQ (LAMBDA (AT FM)(PUTD AT FM]

(DEF DEFPROP
 (NLAMBDA (X)
   (PROG (A)
	[COND((NULL(CAAR X))(RPLACA (CAR X)(LIST(CAR(CDDR X))(CADR X)))(RETURN NIL]
	(SETQ A (CAR (CAR X)))
LOOP	(COND	[ (CDR A)
		   (SETQ A (CDR A))
		   (GO LOOP])
	(RPLACD A (CONS (CAR (CDR (CDR X))) (CONS (CAR (CDR X]

(DEF PUTPROP
 [LAMBDA (A VAL IND)
   (PROG ()
	[COND((NULL(CAR A))(RPLACA A(LIST IND VAL))(RETURN VAL]
	(SETQ A (CAR A))
LOOP	(COND	[ (EQ (CAR A) IND)
		   (RPLACA (CDR A) VAL)
		   (GO END]
		[ (CDR (CDR A))
		   (SETQ A (CDR (CDR A)))
		   (GO LOOP])
	(RPLACD (CDR A) (CONS IND (CONS VAL)))
END	(RETURN VAL]
 ]

'(DEF CAAR (LAMBDA (X) (CAR (CAR X]

'(DEF CADR (LAMBDA (X) (CAR (CDR X]

'(DEF CDAR (LAMBDA (X) (CDR (CAR X]

'(DEF CDDR (LAMBDA (X) (CDR (CDR X]
(DEF GET (LAMBDA (A IND)
   (PROG ()
	(SETQ A (CAR A))
LOOP	(COND	[(EQ A NIL)(RETURN NIL]
		[ (EQ (CAR A) IND)
		   (RETURN (CADR A]
		[ (SETQ A (CDDR A))
		   (GO LOOP]]

'(DEF APPEND (LAMBDA (X Y)
   (PROG (L L*)
	(COND	[ (NULL X)
		   (RETURN Y]
		[ (NULL Y)
		   (RETURN X])
	(SETQ L* (SETQ L (CONS (CAR X))))
LOOP	(COND	[ (SETQ X (CDR X))
		   (SETQ L* (CDR (RPLACD L* (CONS (CAR X)))))
		   (GO LOOP])
	(RPLACD L* Y)
	(RETURN L]

'(DEF AND (NLAMBDA ($A$)
   (PROG ($R$)
	(COND	[ (NULL $A$)
		   (RETURN T])
LOOP	(COND	[ (SETQ $R$ (EVAL (CAR $A$)))
		  (COND	[ (SETQ $A$ (CDR $A$))
			   (GO LOOP]
			[ T
			   (RETURN $R$]]]

'(DEF OR (NLAMBDA ($O$)
   (PROG ($R$)
	(COND	[ (NULL $O$)
		   (GO END])
LOOP	(COND	[ (SETQ $R$ (EVAL (CAR $O$)))
		   (RETURN $R$]
		[ (SETQ $O$ (CDR $O$))
		   (GO LOOP])
END	]

'(DEF MEMBER (LAMBDA ($A$ $L$)
   (PROG ()
	(COND	[ (NULL $L$)
		   (GO END])
LOOP	(COND	[ (EQ $A$ (CAR $L$))
		   (RETURN T]
		[ (SETQ $L$ (CDR $L$))
		   (GO LOOP])
END	]
(DEF MEMCAR (LAMBDA (A L)
   (PROG ()
	(COND	[ (NULL L)
		   (GO END])
LOOP	(COND	[ (EQ A (CAAR L))
		   (RETURN (CDAR L]
		[ (SETQ L (CDR L))
		   (GO LOOP])
END	]

(DEF MEMCDR (LAMBDA (A L)
   (PROG ()
	(COND	[ (NULL L)
		   (GO END])
LOOP	(COND	[ (EQ A (CDAR L))
		   (RETURN (CAAR L]
		[ (SETQ L (CDR L))
		   (GO LOOP])
END	]

'(DEF CONC (LAMBDA (L1 L2)
   (PROG (L1*)
	(COND	[ (NULL L2)
		   (GO END]
		[ (NULL (SETQ L1* L1))
		   (RETURN L2])
LOOP	(COND	[ (CDR L1*)
		   (SETQ L1* (CDR L1*))
		   (GO LOOP])
	(RPLACD L1* L2)
END	(RETURN L1]
'(DEF ADD1 (LAMBDA ($X$) (ADD $X$ 1]

'(DEF SUB1 (LAMBDA ($X$) (DIFF $X$ 1]

'(DEF LIST (NLAMBDA ($L$)
   (PROG ($V$ $V$*)
	(COND	[ (NULL $L$)
		   (GO END])
	(SETQ $V$* (SETQ $V$ (CONS (EVAL (CAR $L$)))))
LOOP	(COND	[ (SETQ $L$ (CDR $L$))
		   (SETQ $V$* (CDR (RPLACD $V$* (CONS (EVAL (CAR $L$))))))
		   (GO LOOP])
END	(RETURN $V$]

'(DEF FUNCTION (NLAMBDA ($X$) (COND [ (ATOM (CAR $X$)) (GETD (CAR $X$))]
				   [ T (CAR $X$]]

'(DEF LENGTH (LAMBDA ($L$)
   (PROG (I)
	(COND	[ (ATOM $L$)
		   (RETURN 0])
	(SETQ I 1)
LOOP	(COND	[ (SETQ $L$ (CDR $L$))
		   (SETQ I (ADD I 1))
		   (GO LOOP])
	(RETURN I]

'(DEF APPLY* (NLAMBDA ($X$)
	(EVAL (CONS (EVAL (CAR $X$)) (CDR $X$]

'(DEF MAPCAR (LAMBDA (MAPCARF $S$)
   (PROG ($R$ $R$*)
	(COND	[ (NULL $S$)
		   (GO END])
	(SETQ $R$* (SETQ $R$ (CONS (APPLY* MAPCARF (CAR $S$)))))
LOOP	(COND	[ (SETQ $S$ (CDR $S$))
		   (SETQ $R$* (CDR (RPLACD $R$* (CONS (APPLY* MAPCARF (CAR $S$))))))
		   (GO LOOP])
END	(RETURN $R$]

'(DEF MAPC (LAMBDA (MAPCF $S$)
   (PROG ($R$)
	(COND	[ (NULL $S$)
		   (GO END])
LOOP	(SETQ $R$ (APPLY* MAPCF (CAR $S$)))
	(COND	[ (SETQ $S$ (CDR $S$))
		   (GO LOOP])
END	(RETURN $R$]

'(DEF COPY (LAMBDA (L)
	(COND	[ (ATOM L)
		   L]
		[ (NUMBP L)
		   L]
		[ T
		   (MAPCAR
		    (FUNCTION COPY)
		    L]]

(DEF DELETE (LAMBDA (A B)
	(COND	[ (NULL B)
		   NIL]
		[ (EQ A (CAR B))
		   (CDR B]
		[ (EQ A (CADR B))
		   (RPLACD B (CDDR B))
		   B]
		[ T
		   (DELETE A (CDR B))
		   B]]

'(DEF LAST (LAMBDA (A)
	(COND	[ (NULL A)
		   NIL]
		[ (NULL (CDR A))
		   A]
		[ T
		   (LAST (CDR A]]

(DEF REVERSE (LAMBDA (X)
   (PROG (TEMP)
	(COND	[ (OR (ATOM X)
		      (NUMBP X))
		   (RETURN X]
		[ (NULL (CDR X))
		   (RETURN (CONS (CAR X]
		[ T
		   (SETQ TEMP (REVERSE (CDR X)))
		   (RPLACD (LAST TEMP) (CONS (CAR X)))
		   (RETURN TEMP]]
(DEF PP (NLAMBDA ($X$)
   (PPEVQ (CAR $X$]

(DEF PPEVQ (LAMBDA ($X$)
   (PROG ()
	(COND	[ (NULL
		  (COND	[ (ATOM $X$)
			   (SETQ $X$ (EVAL $X$]
			[ T
			   $X$]))
		   (GO END])
LOOP	(TERPRI)
	($PATOM1 ' "(DEF ")
	(PRIN1 (CAR $X$))
	($PRPR (GETD (CAR $X$) ))
	($PATOM1 RPAR)
	(TERPRI)
	(COND	[ (SETQ $X$ (CDR $X$))
		   (GO LOOP])
END	]

(DEF $PRPR (LAMBDA (X)
	(COND	[ T
		   (LINELENGTH 70)
		   (TERPRI)
		   ($PRDF X 1 0]]
(DEF $PRDF (LAMBDA (L N M)
   (PROG ()
	($TOCOLUMN N)
A	(COND	[ (OR (ATOM L)
		      (LESSP (ADD M (FLATSIZE L (CHRCT)))
		             (CHRCT)))
		   (RETURN (PRIN1 L]
		[ (AND ($PATOM1 LPAR)
		       (LESSP 2 (LENGTH L))
		       (ATOM (CAR L)))
		   (PROG (C F G H)
			(SETQ G
			 (COND	[ (MEMBER (CAR L) '(LAMBDA NLAMBDA))
				   -7]
				[ T
				   0]))
			(SETQ F (EQ (PRIN1 (CAR L)) 'PROG))
			($PATOM1 ' " ")
			(SETQ C ($DINC))
		   A	($PRD1
			 (CDR L)
			 (ADD
			  C
			  (COND	[ (SETQ H (AND F
				               (CADR L)
				               (ATOM (CADR L))))
				   -5]
				[ T
				   G])))
			(COND	[ (CDR (SETQ L (CDR L)))
				  (COND	[ (OR (NULL H) (ATOM (CADR L)))
					   (TERPRI])
				   (GO A]]
		[ (PROG (C)
			(SETQ C ($DINC))
		  A	($PRD1 L C)
			(COND	[ (SETQ L (CDR L))
				   (TERPRI)
				   (GO A]])
B	($PATOM1 RPAR]
(DEF $PRD1 (LAMBDA (L N)
   (PROG ()
	($PRDF
	 (CAR L)
	 N
	 (COND	[ (NULL (SETQ L (CDR L)))
		   (ADD M 1]
		[ (ATOM L)
		   (SETQ N)
		   (PLUS 4 M (PNTLEN L]
		[ T
		   M]))
	(COND	[ (NULL N)
		   ($PATOM1 ' " . ")
		   (RETURN (PRIN1 L]]

(DEF FLATSIZE (LAMBDA (L $MLEN)
   (PROG ($LEN)
	(SETQ $LEN 0)
	($FLT1 L)
	(RETURN $LEN]

(DEF $FLT1 (LAMBDA (L)
	(COND	[ (OR (ATOM L)
		      (NUMBP L))
		   ($ADDL (PNTLEN L]
		[ (AND (CDR L)
		       (OR (ATOM (CDR L))
		           (NUMBP (CDR L))))
		   ($FLT1 (CAR L))
		   ($ADDL (PNTLEN (CDR L]
		[ T
		   ($ADDL (ADD (LENGTH L) 2))
		   (MAPC (GETD '$FLT1 ) L]]
(DEF $ADDL (LAMBDA (N)
	(COND	[ T
		   (SETQ $LEN (ADD $LEN N))
		  (COND	[ (GREATERP $LEN $MLEN)
			   (RETURN 1000]]]

(DEF $DINC (LAMBDA () (DIFF (LINELENGTH) (CHRCT]

(DEF $TOCOLUMN (LAMBDA (N)
   (PROG ()
LOOP	(COND	[ (LESSP ($DINC) N)
		   ($PATOM1 ' " ")
		   (GO LOOP]]

(DEF PRIN1 (LAMBDA (X)
	(COND	[ T
		   (PRINT X POPORT)
		   X]]

(DEF TERPRI (LAMBDA () (TERPR POPORT]

(DEF CHRCT (LAMBDA () (CHARCNT POPORT]

(DEF $PATOM1 (LAMBDA (X) (PATOM X POPORT]